home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / mus / edit / WaveTracer.lha / WaveTracer / Doc / Developer / Sources / Grammophon.eff.p next >
Text File  |  1996-08-11  |  9KB  |  213 lines

  1. Program Effectmod;
  2.  
  3. { Dieses Programm ist © by QXC & VWP! Alle Rechte liegen beim Autor!
  4.   Alle Sourcecodes sind nur zur Demonstration und Veranschaulichung des
  5.   WaveTracer-Modulinterfaces gedacht und zu verwenden }
  6.  
  7. USES Intuition,Graphics,ExecIO;
  8.  
  9.  
  10. type BPTR=long;
  11.  
  12. var DWindow                             :^Window;
  13.  
  14. var XGadget                             :^Gadget;
  15. var Schieber,Textgad                    :array [1..2] of Gadget;
  16. var SchieberInfo                        :array [1..2] of PropInfo;
  17. var TextInfo                            :array [1..2] of StringInfo;
  18. var SImage                              :array [1..2] of Image;
  19. var Buffer,UndoBuffer                   :array [1..2] of string[20];
  20.  
  21. var IMsg                                :^IntuiMessage;
  22. var Addr1,RealE1                        :long;
  23. var Data1                               :^long;
  24. var RawCode,GadCode,ChBit,ChID          :byte;
  25. var i                                   :integer;
  26. var l                                   :long;
  27. var Valid                               :boolean;
  28.  
  29. {$path "WaveTracer/","RAM:include/";incl "WTIncl.mod","ModIncl.mod",
  30.        "EffIncl.mod","Schieber.mod"}
  31.  
  32. { WTIncl.mod   - WaveTracer Strukturen
  33.   ModIncl.mod  - Proceduren und Strukturen sowie Variablendefinitionen
  34.                  zum Port-Handling
  35.   EffIncl.mod  - Proceduren für Effektmodule, wie z.B. WRITE oder
  36.                  MAKEBORDER (nicht mitgeliefert, da hier keine umwerfend
  37.                  komplizerte oder innovative Routinen implementiert sind)
  38.   Schieber.mod - Procedure zum einfachen Generieren von Prop-Gadgets }
  39.  
  40.  
  41.  
  42. procedure DOGRAMMOPHON(SAddr :long);
  43.  
  44. var SwapData                    :boolean;
  45. var NewData                     :long;
  46.  
  47. begin
  48.    if SAddr=0 then exit;
  49.    SwapData:=false;
  50.    with MyWTStdMsg^ do begin
  51.       Flags:=0;
  52.       WTMsgPrc^:=MsgPrc(WTM_GETABORTINFO,'','','','','',0,0,0,0,0,NIL);
  53.                                 { WTM_GETABORTINFO-Abfrage vorbereiten }
  54.       Addr1:=SAddr;
  55.       randomize;
  56.       i:=0;
  57.       repeat
  58.          repeat
  59.             Data1:=ptr(Addr1); Addr1:=Addr1+4;
  60.             NewData:=random(ActWaveOp^.Operator[1]*3); NewData:=NewData*10000;
  61.            if Data1^>0 then Data1^:=Data1^-NewData;
  62.             if Data1^<=0 then Data1^:=Data1^+NewData;
  63.             if ((random(255)=0) and (random(67-ActWaveOp^.Operator[1])=0)) or
  64.              ((random(255)=0) and (abs(Data1^)>600000))
  65.              then if SwapData then SwapData:=false else SwapData:=true;
  66.             if SwapData then Data1^:=Data1^*(-1);
  67.             i:=i+1;
  68.          until (Addr1>=RealE1) or (i>2000);
  69.          i:=0;
  70.          MESSAGEHANDLE;         { alle 2000 Schritte wird WTM_GETABORTINFO auf
  71.                                   gerufen, um abzufragen, ob evtl. die Esc-Taste
  72.                                   gedrückt wurde }
  73.          if WTMsgPrc^.PRC_Long1=-1 then begin
  74.                                 { PRC_Long1=-1 -> Operation wurde unterbrochen }
  75.             Valid:=false;
  76.             exit;
  77.          end;
  78.       until Addr1>=RealE1;
  79.    end;
  80. end;
  81.  
  82.  
  83.  
  84. procedure DEFINEGRAMMOPHON;
  85.  
  86. begin
  87.    with MyWTStdMsg^ do begin
  88.       with ActWaveOp^ do if Operator[1]=-1 then begin
  89.                                 { Wenn Operator[1]-1 ist, so wurde das Modul
  90.                                   zum ersten mal aufgerufen. Es sind die nötigen
  91.                                   Voreinstellungen zu tätigen }
  92.          Operator[1]:=10;
  93.          Channels:=UsedChannels;
  94.       end;
  95.       Flags:=0;
  96.       WTMsgPrc^:=MsgPrc(WTM_OPENDWIN,'Definition GRAMMOPHON','','','','',120,0,3,0,0,NIL);
  97.       MESSAGEHANDLE;
  98.                                 { Definitionsfenster öffnen: Höhe 120 Punkte
  99.                                   Gadgets: OK/Cancel -> 1
  100.                                            Kanalgadgets -> 2 }
  101.       if (WTMsgPrc^.PRC_Long1=-1) or (WTMsgPrc^.PRC_NewPtr=NIL) then begin
  102.                                 { Abbrechen, wenn PRC_Long1=-1 oder
  103.                                   PRC_NewPtr=NIL, da das Fenster nicht geöffnet
  104.                                   werden konnte }
  105.          Flags:=MDE_ERROR;
  106.          exit;
  107.       end;
  108.       DWindow:=WTMsgPrc^.PRC_NewPtr;
  109.                                 { Pointer auf Window-Struktur }
  110.       WTMsgPrc^:=MsgPrc(WTM_SETCHANNELGADS,'','','','','',ActiveMode,ActWaveOp^.Channels,0,0,0,NIL);
  111.       MESSAGEHANDLE;
  112.                                 { Kanalgadgets im Fenster Selektieren: Soundmode
  113.                                   und voreingestellte Kanäle als Defaultwerte }
  114.       CREATEPROPGAD(10,80,pred(ActWaveOp^.Operator[1])*1331,1331,1,8,DWindow^);
  115.                                 { eine "Schieber.mod"-Procedure }
  116.       Buffer[1]:=intstr(ActWaveOp^.Operator[1]);
  117.  
  118.       WRITE(410,81,2,0,DWindow^,'Rausch- und Knister-Faktor');
  119.       AddGadget(DWindow,^TextGad[1],NIL);
  120.       AddGadget(DWindow,^Schieber[1],NIL);
  121.       RefreshGadgets(DWindow^.FirstGadget,DWindow,NIL);
  122.       repeat
  123.  
  124.          RawCode:=0; GadCode:=0; Valid:=false;
  125.          l:=wait(-1);
  126.          IMsg:=Get_Msg(DWindow^.UserPort);
  127.          If IMsg<>Nil Then begin
  128.             if IMsg^.class in [GADGETDOWN,GADGETUP] then begin
  129.                XGadget:=IMsg^.IAddress; GadCode:=XGadget^.GadgetID;
  130.             end;
  131.             if IMsg^.class=RAWKEY then RawCode:=IMsg^.Code;
  132.             Reply_Msg(IMsg);
  133.             Valid:=true;
  134.          End;
  135.  
  136.          if (Gadcode=9) or not (Schieber[1].flags and SELECTED=0) then begin
  137.             ActWaveOp^.Operator[1]:=succ(SchieberInfo[1].HorizPot div 1337);
  138.             Buffer[1]:=intstr(ActWaveOp^.Operator[1]);
  139.             RefreshGadgets(^TextGad[1],DWindow,NIL);
  140.          end;
  141.          if Gadcode=10 then begin
  142.             val(Buffer[1],ActWaveOp^.Operator[1],i);
  143.             if ActWaveOp^.Operator[1]<1 then ActWaveOp^.Operator[1]:=1;
  144.             if ActWaveOp^.Operator[1]>50 then ActWaveOp^.Operator[1]:=50;
  145.             Buffer[1]:=intstr(ActWaveOp^.Operator[1]);
  146.             SchieberInfo[1].HorizPot:=pred(ActWaveOp^.Operator[1])*1337;
  147.             RefreshGadgets(^Schieber[1],DWindow,NIL);
  148.          end;
  149.  
  150.       Until (GadCode in [1..2]) or (RawCode=68) or (RawCode=69);
  151.       Flags:=0;
  152.       WTMsgPrc^:=MsgPrc(WTM_GETCHANNELGADS,'','','','','',0,0,0,0,0,NIL);
  153.       MESSAGEHANDLE;
  154.       ActWaveOp^.Channels:=WTMsgPrc^.PRC_Long1;
  155.                                 { Kanalgadgets auf Selektierung hin abfragen }
  156.       WTMsgPrc^:=MsgPrc(WTM_LEAVEWIN,'','','','','',Rawcode,GadCode,0,0,0,DWindow);
  157.       MESSAGEHANDLE;
  158.                                 { Das Fenster wieder schließen; es darf hier nicht
  159.                                   mit CloseWindow geschlossen werden, wenn mit
  160.                                   WTM_OPENDWIN geöffnet wurde! }
  161.       if WTMsgPrc^.PRC_Long1=1 then Flags:=MDE_READY else Flags:=MDE_CANCELLED;
  162.                                 { Ergebnis von WTM_LEAVEDEF: 1 - OK-Gadget ge-
  163.                                   drückt -> mit MDE_READY beenden sonst Cancel-
  164.                                   Gadget gedrückt -> mit MDE_CANCELLED beenden }
  165.    end;
  166. end;
  167.  
  168.  
  169.  
  170. begin {*** MAIN ***}
  171.    OpenLib(IntBase,'intuition.library',0);
  172.    OpenLib(GfxBase,'graphics.library',0);
  173.    if CREATEPORTS(PORT_EFFECTMOD) then begin
  174.                                 { "ModIncl.mod": Messageport anlegen }
  175.       with MyWTStdMsg^ do if Version=VERSION_EFFECTMOD then begin
  176.          if Flags=MDC_DEFINEIT then DEFINEGRAMMOPHON
  177.                                 { Vom WaveTracer kam das Kommando, die nötigen
  178.                                   Einstellungen zu definieren }
  179.          else if Flags=MDC_DOIT then begin
  180.                                 { Kommando Operation ausführen }
  181.             Flags:=0;
  182.             WTMsgPrc^:=MsgPrc(WTM_WORKINFO,'Grammophon, '+COPYRIGHT,'','','','',0,0,0,0,0,NIL);
  183.             MESSAGEHANDLE;
  184.                                 { Copyright-Info ausgeben und damit Status-
  185.                                   Anzeige zeichnen; Unbedingt notwendig! }
  186.             Valid:=true;
  187.             ChBit:=1;
  188.             for ChID:=1 to 6 do begin
  189.                if Valid and not (ActWaveOp^.Channels and ChBit=0) then begin
  190.                   Flags:=0;
  191.                   WTMsgPrc^:=MsgPrc(WTM_GETMARKADDR,'','','','','',ChID,0,0,0,0,NIL);
  192.                   MESSAGEHANDLE;
  193.                                 { WTM_GETMARKADDR liefert die Absoluten Adressen
  194.                                   des markierten Bereiches; Funktion ist zukünftig
  195.                                   durch WTM_GETOFFSET zu ersetzen!! }
  196.                   RealE1:=WTMsgPrc^.PRC_Long3;
  197.                                 { Absolute EndAdresse }
  198.                   DOGRAMMOPHON(WTMsgPrc^.PRC_Long1);
  199.                                 { Operation mit Absoluter Anfangsadresse ausführen }
  200.                end;
  201.                ChBit:=ChBit*2;
  202.             end;
  203.             Flags:=MDE_READY;
  204.          end;
  205.       end else Flags:=MDE_WRONG_MODULEVERSION;
  206.                                 { Moduleversion wurde nicht erkannt! }
  207.       MESSAGEHANDLE;            { Messagehandling in "ModIncl.mod" }
  208.       RemPort(MyPort);          { Port wieder entfernen }
  209.    end;
  210.    CloseLib(GfxBase);
  211.    CloseLib(IntBase);
  212. end.
  213.